Shareware Grab Bag/Shareware Grab Bag.iso/050/madtrb8.arc/UTIL.INC

Text File | 1985-02-23 | 56.4 KB | 1,654 lines

{****************************************************************************
 *  This Module Comprises the various utility routines used by the other    *
 * modules in the program.  Routines included in this module are:           *
 *                                                                          *
 *         Routine                   Use                                    *
 *  *  1   Upper_Left_X      Returns the left x coordinate of active window *
 *  *  2   Upper_Left_Y      Returns the upper y coord of active window     *
 *  *  3   Lower_Right_X     Returns the right x coord of active window     *
 *  *  4   Lower_Right_Y     Returns the lower y coord of active window     *
 *  *  5   RvsOn             Turns on Reverse Video                         *
 *  *  6   RvsOff            Turns off Reverse Video                        *
 *     7   Yes               Prints a prompt, if user inputs 'Y' returns    *
 *                           Trues, otherwise returns False                 *
 *  *  8   Click             Produces a single click from the PC speaker    *
 *  *  9   Alert             Prints a message to the screen and makes noise *
 *  * 10   Beep              Makes noise for a specified period of time     *
 *    11   Replicate         Duplicates a character a specified no. of times*
 *    12   Left              Left justifys a string in a field of spaces    *
 *    13   Center            Centers a string in a field of specified width *
 *    14   Get_Payment_Amount Calculates a loan payment amount              *
 *    15   Write_Neatly      Outputs numbers with commas                    *
 *    16   Get_Str           Writes a string to the screen, allows it to be *
 *                           edited and returns the terminating character   *
 *    17   Get_Num           Does for numbers what Get_Str does for strings *
 *  * 18   Frame             Frames a specified portion of the screen       *
 *  * 19   UnFrame           Removes the frame from the screen              *
 *  * 20   Menu              Displays a menu and gets a user input          *
 *  * 21   Clear_Window      Clears the screen within a window              *
 *  * 22   Window_Frame      Sets up, frames and titles a screen window     *
 *    23   Encrypt           Encrypts a string using XOR                    *
 *    24   Decrypt           Decrypts a string encrypted by encrypt         *
 *    25   GetChar           Gets a character from the keyboard             *
 *    26   Wait              Waits for a KeyPressed                         *
 *    27   Get_Pass          Gets a password from the user                  *
 *  * 28   Push_Screen       Saves the current screen                       *
 *  * 29   Pop_Screen        Restores a saved screen                        *
 *    30   Inc               Increments an integer by 1                     *
 *    31   Dec               Decrements an integer by 1                     *
 *  * 32   Setup             Sets the IBM Serial Interface                  *
 *    34   Upper             Convert String to Upper Case                   *
 *    35   Lower             Convert String to Lower Case                   *
 *  * 36   DosConOut         Usr Device Driver.  Calls DOS Video Output     *
 *  * 37   SerialIn          Aux Device Driver.  Serial port input          *
 *  * 38   SerialOut         Aux Device Driver.  Serial port output         *
 *    39   Power             Raises a number to a power                     *
 *  * 40   Data              Returns true if there is data at the RS232     *
 *  * 41   ColScr            Switch to color monitor if there               *
 *  * 42   MonoScr           Switch to Monochrome monitor if there          *
 *  * 43   Marquee           Display Marquee and put message in it          *
 *  * 44   Help              Displays an appropriate help screen            *
 *  * 45   Well              Expresses impatience                           *
 *  * 47   Siren             makes a sound like a siren                     *
 *  * 48   GetForm           generalized input routine                      *
 *  * 49   Date              gets the date from the system                  *
 *  * 50   Time              gets time from system                          *
 *  * 51   Push_Window       pushes a small section of the screen           *
 *  * 52   Elapsed_time      the time in seconds from the argument          *
 *                                                                          *
 *  * Indicates that the routine has IBM PC specific sections and would need*
 *    to be modified for other computers                                    *
 ****************************************************************************}

Procedure HighVideo;

Begin
  TextColor(White);
  TextBackground(Black);
End;

Procedure NormVideo;

Begin
  TextColor(White);
  TextBackground(Black);
End;

Procedure LowVideo;

Begin
  TextColor(LightGray);
  TextBackground(Black);
End;

Type
  Parity_Types = (Odd_Parity, Even_Parity, No_Parity);
  Reg          = Record
    AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
  End;

Const
  COM1  =  1016;  {Com1 and Com2 Base port address}
  DLL   =   0;    {LSB of Divisor Latch, Offset 0, R/W}
  DLM   =   1;    {MSB of Divisor Latch, Offset 1, R/W}
  LCR   =   3;    {Line Control Register, Offset 3, R/W}
  MCR   =   4;    {Modem Control Register, Offset 4, R/W}
  LSR   =   5;    {Line Status Register, Offset 5, RO}
  MSR   =   6;    {Modem Status Register, Offset 6, RO}
  MRR   =   7;    {Modem Rate Register, Offset 7, RO, (1200B Hayes only)}
  DLAB  =   128;  {Data Latch Access Bit, High to access DLL and DLM}
  SBRK  =   64;   {Set Break, High to transmit a break signal}
  STPTY =   32;   {Stick Parity, If high parity bit follows EPS}
  EPS   =   16;   {Select Even Parity, High for Even parity}
  PEN   =   8;    {Parity Enable, High to enable parity checking}
  STB   =   4;    {Stop Bits, High for 2 stop bits (1.5 for 5 bit word)
                   low for 1 stop bit}
  WLS   =   3;    {Select Number of bits per word as follows:
                    Bit 1            Bit 2     Word Length
                      0                0         5 Bits
                      0                1         6 Bits
                      1                0         7 Bits
                      1                1         8 Bits}
  LOOP  =   16;   {Enable loop back for testing}
  OUT2  =   8;    {Enable interrupt line drivers if high}
  OUT1  =   4;    {Reset Smartmodem 1200B}
  RTS   =   2;    {Request to send follows this bit}
  DTR   =   1;    {Data Terminal Ready follows this bit inversely, required
                   for modem operation}

{****************************************************************************}
Function Upper_Left_X : Integer;       {* These four routines allow a       *}
{1*}                                   {* routine to adjust its output      *}
Begin                                  {* according to what size window it  *}
  Upper_Left_X := Mem[Dseg:$156] + 1;  {* is operating in.  They are        *}
End;                                   {* compatible only with Turbo Pascal *}
                                       {* version 2.0 on an IBM PC or       *}
Function Upper_Left_Y : Integer;       {* compatible                        *}
{2*}
Begin
  Upper_Left_Y := Mem[Dseg:$157] + 1;
End;

Var
{3*}
  Lower_Right_X : Byte Absolute Cseg:$16A;
{4*}
  Lower_Right_Y : Byte Absolute Cseg:$16B;

{****************************************************************************}
Procedure RvsOn;                       {*  These two routines turn on and   *}
{5*}                                   {*  off Reverse video on the IBM PC  *}
Begin                                  {*************************************}
  TextColor(0);
  TextBackGround(7);
End;

Procedure RvsOff;
{6*}
Begin
  LowVideo;
End;

{30**************************************************************************}
Procedure Inc(                     {* Increment argument by One             *}
          Var I : Integer);        {*****************************************}

Begin
  I := I + 1;
End;

{31**************************************************************************}
Procedure Dec(                     {* Decrement argument by One             *}
          Var I : Integer);        {*****************************************}

Begin
  I := I - 1;
End;

{26**************************************************************************}
Procedure Wait;                       {* Wait for a keypress from the KBD   *}
                                      {**************************************}
Var
  AnyKey : Char;

Begin
  Read(Kbd,AnyKey);
End;

{****************************************************************************}
Type                                   {* Just a couple of type declarations*}
  Menu_Item       = String[40];        {* needed for a number of routines   *}
                                       {*************************************}
  Menu_Selections = Array[1..15] of Menu_Item;
  Long_String     = String[255];
  Register        = Record
                    AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
                    End;
  ScreenLoc       = Record
    Ch            : Char;
    Attrib        : Byte;
  End;
  Video           = Array[1..25] of Array[1..80] of ScreenLoc;
  Video_Ptr       = ^Video_Stack;
  vidscr          = array[1..1] of screenloc;
  Video_Stack     = Record
                    Next_Screen  : Video_Ptr;
                    x1,y1,
                    x2,y2        : byte;
                    Screen_store : ^vidscr;
                    End;

Var
  ScreenBuffer  : Video;
  Screen_Stack  : Video_Ptr;
  Screen        : ^Video;
  Com           : Integer;
  HelpContext   : Integer;
  ScreenFile    : File of Video;

{7***************************************************************************}
Function Yes(Prompt : Long_String) : Boolean;{* This routine prints PROMPT  *}
                                             {* to the screen and waits for *}
Var                                          {* the user to type either a   *}
  Inchar : Char;                             {* 'y' or 'n'.  It is case     *}
                                             {* insensitive.  If a 'y' is   *}
Begin                                        {* entered, the function       *}
  Write(Prompt);                             {* returns TRUE.               *}
  Repeat                                     {*******************************}
    Read(Kbd,Inchar);
  Until Inchar in ['Y','y','N','n'];
  Write(Inchar);
  Yes := Inchar in ['Y','y'];
End;

{34**************************************************************************}
Function Upper (S : Long_String)       {* Convert Strng S to Upper case     *}
               : Long_String;          {* Return uppercase string           *}
                                       {*************************************}
Var
  I : Integer;
  lcase : Set of Char;

Begin
  lcase := ['a'..'z'];

  For I := 1 to Length(S) do
    If S[I] In lcase then
      S[I] := Char(Ord(S[I]) - 32);
  Upper := S;
End;

{35**************************************************************************}
Function Lower (S : Long_String)    {* Convert string S to lowercase        *}
               : Long_String;       {* Return lowercase string              *}
                                    {****************************************}
Var
  I : Integer;
  ucase : Set of Char;

Begin
  ucase := ['A'..'Z'];

For I := 1 to Length(S) do
  If S[I] in ucase then
    S[I] := Char(Ord(S[I]) + 32);
lower := S;
End;

{8***************************************************************************}
Procedure Click;                       {* Makes a clicking noise            *
                                        *************************************}
var f,n : integer;

Begin
  Sound(2000);
  Delay(5);
  NoSound;
End;

{9***************************************************************************}
Procedure Alert(Message : Long_String);{* This routine prints MESSAGE to the*}
                                       {* screen and makes an obnoxious     *}
Var                                    {* noise for about 1 second          *}
  I : Integer;                         {*************************************}
  i1,i2,i3,i4 : integer;


begin
  write(Message);
  for i4 := 1 to 10 do
    begin
    i2 := 250 + i4 * 25;
    for i3 := 1 to 2 do
      begin
      for i1 := 1 to 30 - i3 * 2 do
        begin
        sound(i1 + i2 + i3 * 2);
        delay(2);
        end;
      delay(5);
      i2 := i2 + 30;
      end;
    nosound;
    end;
end;

{21**************************************************************************}
Procedure Clear_Window;          {* Clear the Active window                 *}
                                 {*******************************************}
Var
  I : Integer;

Begin
For I := 1 to Lower_Right_Y - Upper_Left_Y + 1 do
  Begin
  GotoXY(1,I);
  ClrEol;
  End;
End;

{10**************************************************************************}
Procedure Beep(N : Integer);    {*  This routine sounds a tone of frequency *}
                                {*  N for approximately 100 ms              *}
Begin                           {********************************************}
  Sound(n);
  Delay(100);
  NoSound;
End;

{28**************************************************************************}
Procedure Push_Screen;                {* This routine stores the current    *}
                                      {* screen into a temporary storage    *}
                                      {* area                               *}
                                      {**************************************}
Var
  Temp   : Video_Ptr;
  i,j,k  : integer;

Begin
  If (MaxAvail < 0) or (MaxAvail > 4096) then
    Begin
    If Screen = Nil then
      Screen := Ptr($B000,0);
    new(Temp);
    temp^.x1 := 1;
    temp^.y1 := 1;
    temp^.x2 := 80;
    temp^.y2 := 25;
    getmem(temp^.screen_store,4000);
    Temp^.Next_Screen := Screen_Stack;
    k := 1;
    for i := 1 to 25 do
      for j := 1 to 80 do
        begin
        temp^.screen_store^[k] := screen^[i][j];
        inc(k);
        end;
    Screen_Stack := Temp;
    End
  Else
    Begin
    Alert('Insufficient Memory - You are being dumped');
    Halt;
    End;
End;

{29**************************************************************************}
Procedure Pop_Screen;                 {* This routine Pops a screen from the*}
                                      {* Screen Stack                       *}
                                      {**************************************}
Var
  Temp   : Video_Ptr;
  i,j,k  : integer;

Begin
  If Screen = nil then
    Screen := Ptr($B000,0);

  k := 1;
  for i := screen_stack^.y1 to screen_stack^.y2 do
    for j := screen_stack^.x1 to screen_stack^.x2 do
      begin
      screen^[i][j] := screen_stack^.screen_store^[k];
      inc(k);
      end;

  Temp := Screen_Stack;
  Screen_Stack := Screen_Stack^.Next_Screen;
  freemem(Temp^.screen_store,
    ((temp^.x2 - temp^.x1 + 1) * (temp^.y2 - temp^.y1 + 1)) * 2);
  dispose(temp);
End;

{43**************************************************************************}
Procedure Marquee                    {* Draws a marquee in center screen    *}
                 (Str : Long_String);{* Around the input parameter          *}
                                     {***************************************}

Const
  OnChr = #1;
  OffChr = #2;

Var
  I,J,K : Integer;
  X,Y   : Integer;
  Astrsk : Array[1..4] of Record
                            X,Y : Integer;
                            OldX,OldY : Integer;
                            XI,YI     : Integer;
                          End;

Begin
  Window(1,1,80,25);
  Push_Screen;
  ClrScr;
  X := 40 - Length(Str) Div 2 - 2;
  For I := 10 to 14 do
    Begin
    Screen^[I][X].Ch := OnChr;
    Screen^[I][X].Attrib := 7;
    Screen^[I][X + Length(Str) + 3].Ch := OnChr;
    Screen^[I][X + Length(Str) + 3].Attrib := 7;
    End;
  For I := X to X + Length(Str) + 3 do
    Begin
    Screen^[10][I].Ch := OnChr;
    Screen^[14][I].Ch := OnChr;
    Screen^[10][I].Attrib := 7;
    Screen^[14][I].Attrib := 7;
    End;
  GotoXY(X+2,12);
  HighVideo;
  Write(Str);
  LowVideo;

  Astrsk[1].X := 40;
  Astrsk[1].Y := 10;
  Astrsk[1].XI := 1;
  Astrsk[1].YI := 0;
  Astrsk[2].X := X;
  Astrsk[2].Y := 12;
  Astrsk[2].XI := 0;
  Astrsk[2].YI := -1;
  Astrsk[3].X := X + Length(Str) + 3;
  Astrsk[3].Y := 12;
  Astrsk[3].XI := 0;
  Astrsk[3].YI := 1;
  Astrsk[4].X := 40;
  Astrsk[4].Y := 14;
  Astrsk[4].XI := -1;
  Astrsk[4].YI := 0;
  Astrsk[4].OldX := Astrsk[1].X;
  Astrsk[4].OldY := Astrsk[1].Y;
  Astrsk[3].OldX := Astrsk[2].X;
  Astrsk[3].OldY := Astrsk[2].Y;
  Astrsk[2].OldX := Astrsk[3].X;
  Astrsk[2].OldY := Astrsk[3].Y;
  Astrsk[1].OldX := Astrsk[4].X;
  Astrsk[1].OldY := Astrsk[4].Y;
  K := 1;

  Repeat
    If K > 4 Then
      K := 1;

    J := Astrsk[K].Y;
    I := Astrsk[K].X;

    If Screen = Ptr($B800,0) then
      Repeat Until (Port[$3DA] And 1) = 1
    Else
      Repeat Until (Port[$3BA] And 1) = 1;

    Screen^[J][I].Ch := OffChr;
    Screen^[Astrsk[K].OldY][Astrsk[K].OldX].Ch := OnChr;
    Screen^[J][I].Attrib := 15;
    Screen^[Astrsk[K].OldY][Astrsk[K].OldX].Attrib := 7;

    Astrsk[K].OldX := Astrsk[K].X;
    Astrsk[K].OldY := Astrsk[K].Y;

    I := I + Astrsk[K].XI;
    J := J + Astrsk[K].YI;

    If I > (X + Length(Str) + 3) then
      Begin
      I := I - Astrsk[K].XI;
      Astrsk[K].XI := 0;
      Astrsk[K].YI := 1;
      End;

    If J > 14 then
      Begin
      J := J - Astrsk[K].YI;
      Astrsk[K].YI := 0;
      Astrsk[K].XI := -1;
      End;
    If I < X then
      Begin
      I := I - Astrsk[K].XI;
      Astrsk[K].XI := 0;
      Astrsk[K].YI := -1;
      End;
    If J < 10 then
      Begin
      J := J - Astrsk[K].YI;
      Astrsk[K].YI := 0;
      Astrsk[K].XI := 1;
      End;

    Astrsk[K].Y := J;
    Astrsk[K].X := I;
    Inc(K);

  Until KeyPressed;
  Wait;
  Pop_Screen;
End;

{44**************************************************************************}
Procedure Help;                      {* This routine reads a screen from the*}
                                     {* Screen file and displays it         *}
Begin                                {***************************************}
  Push_Screen;
  {$I-}
  Seek(ScreenFile,HelpContext);
  {$I+}
  If IOResult = 0 Then
    Begin
    {$I-}
    Read(ScreenFile,ScreenBuffer);
    {$I+}
    Screen^ := ScreenBuffer;
    If IOResult <> 0 Then
      Marquee('Sorry, I''m helpless in this situation')
    Else
      Wait;
    End
  Else
    Marquee('Sorry, wish I could help you.');
  Pop_Screen;
End;

{11**************************************************************************}
Function Replicate (                          {* Repeat a character         *}
                     Count : Integer;         {* Number of Repititions      *}
                     Ascii : Char             {* Character to be repeated   *}
                    )      : Long_String;     {* String containing repeated *}
                                              {* character                  *
 * This function takes the character in 'Ascii', repeats it 'Count' times   *
 * and returns the resulting string as a 'Long_String'                      *
 ****************************************************************************}

Var
  Temp : Long_String;  {Used to hold the incomplete result}
  I    : Byte;         {For Counter}

Begin
  Temp := '';
  For I := 1 to Count do
    Temp := Temp + Ascii;
  Replicate := Temp;
End; {Replicate}

{12*************************************************************************}
Function Left (                       {* Left Justifies a string in a      *}
                Str : Long_String;    {* field of spaces                   *}
                Width : Integer       {*************************************}
              ) : Long_String;

Begin
  If Length(Str) > Width then
    Left := Copy(Str,1,Width)
  Else
    Left := Str + Replicate(Width - Length(Str),' ');
End;

{13**************************************************************************}
Function Center (                              {* Centers a string in field *}
                  Field_Width   : Byte;        {* Width of field for center *}
                  Center_String : Long_String  {* String to Center          *}
                )               : Long_String; {* Return the string         *}
{************************************************                           *
 * This functions takes the string 'Center_String' and centers it in a      *
 * field 'Field_Width' Spaces long.  It returns a 'Long_String' with a      *
 * length equal to 'Field_Width'.  If the 'Center_String' is longer than    *
 * field width, it is truncated on the right end and is not centered.       *
 ****************************************************************************}

Var
  Temp   : Long_String;
  Middle : Byte;

Begin
  Middle := Field_Width div 2;
  If Length(Center_String) > Field_Width then
    Center := Copy(Center_String,1,Field_Width) {Truncate and return}
  Else
    Begin
    Temp := Replicate(Middle - (Length(Center_String) div 2),' ') +
            Center_String +
            Replicate(Middle - (Length(Center_String) div 2) + 1,' ');
    Center := Copy(Temp, 1, Field_Width)  {Truncate to Field_Width Characters}
    End {Else}
 End; {Center}

{39*************************************************************************}
Function Power(X : Real; Y : Integer):   {* This function raises X to the  *}
               Real;                     {* Yth power                      *}
                                         {**********************************}
Var
  I : Integer;
  N : Real;

Begin
  N := 1.0;
  For I := 1 To Y do
    N := N * X;
  Power := N;
End; {Power}

{14*************************************************************************}
Function  Get_Payment_Amount (Loan_Amount :   Real;
                              Interest_Rate : Real;
                              Amort_Over    : Real
                             )              : Real;

VAR

  Monthly_Interest_Rate   :  Real;
  Number_of_Payments      :  Integer;

BEGIN

  Monthly_Interest_Rate  :=  (Interest_Rate / 100.0) / 12.0;
  Number_of_Payments  := Trunc (Amort_Over * 12);
  Get_Payment_Amount := Loan_Amount *
    (1 / ((1 - 1 / Power((1 + Monthly_Interest_Rate),Number_Of_Payments))/
    Monthly_Interest_Rate));

END;

{15**************************************************************************}
Procedure Write_Neatly (                 {* Routine to write numbers        *}
                   var OutFile  : Text;  {* output file                     *}
                       Number   : Real;  {* Number to be written            *}
                       Width    : Byte;  {* Width of write area             *}
                       Max_Dec  : Byte   {* Number of decimal places        *}
                       );                {* This routine takes NUMBER, and  *}
                                         {* formats it with commas and      *}
                                         {* truncates to MAX_DEC decimal    *}
                                         {* places.  If NUMBER is to big to *}
                                         {* fit in WIDTH, then a row of     *}
                                         {* asterisks WIDTH long is output  *}
                                         {***********************************}
Const
  Valid_Digits : Set of char = ['0'..'9','.','-','+','e'];

Var
  Field : Long_String;
  Point : Integer;
  I,J   : Integer;       {Spares for counters}

Begin
  For I := 1 to Max_Dec do
    Number := Number * 10;
  Number := Number + 0.6;
  For I := 1 to Max_Dec do
    Number := Number / 10;
  Str(Number:0:20,Field);  {Convert the input to a string}
  I := 1;

  I := Pos('.',Field);  {Where's the Decimal!}

  If I = 0 then
    Begin
    Field := Field + '.';     {If no decimal, then add one}
    Point := Length(Field);
    End
  Else
    Point := I;

  I := Point - 3;  {Get the Point?}

  While I > 1 do             {put in commas, start at the back and work }
    Begin                    {to the front}
    Insert(',',Field,I);
    I := I - 3
    End;

  I := Pos('.',Field) - 1;    {Find that pesky decimal}
  J := 0;

  While J <= Max_Dec do
    Begin
    I := I + 1;                  {Pad to Max_Dec with zeros}
    If I >= Length(Field) then
      Field := Field + '0';
    J := J + 1;
    End;

  Field := Copy(Field,1,I);      {Clean it up a little and elimate trailers}

  If Max_Dec = 0 then
    Field := Copy(Field,1,I - 1); {Truncate to integer if necessary}

  If (Length(Field) > Width) and (Width > 0) then
    Write(Replicate(Width,'*'))  {Too Big! tell with asterisks}
  Else
    Write(OutFile,Field:Width);  {all that for this}

End;

{16**************************************************************************}
Function Get_Str (                          {* Get a string with editing    *}
             Var In_Str      : Long_String; {* String to be edited          *}
                 Buffer_Len  : Integer;     {* Its length                   *}
                 Start_X     : Integer;     {* Column to start in           *}
                 Y           : Integer;     {* Row for input                *}
                 Force_Case  : Boolean      {* Force Input to Upper case    *}
                 )           : Char;        {* Return terminating Character *}
                                            {*                              *}
                                            {* This is a fairly versatile   *}
                                            {* string input and editing     *}
                                            {* routine.  It takes IN_STRING *}
                                            {* displays it at START_X,ROW   *}
                                            {* allows the user to edit the  *}
                                            {* string using WordStar(tm)    *}
                                            {* commands.  It returns the    *}
                                            {* character used to terminate  *}
                                            {* input.  By setting FORCE_CASE*}
                                            {* true, all input is forced to *}
                                            {* upper case                   *}
                                            {********************************}
Const
  KeyClick = True;

Var
  Insert_Mode  : Boolean;
  Done         : Boolean;
  Current_Char : Char;
  X            : Byte;
  Escape       : Boolean;
  Current      : Char;
  in_string    : Long_String;

Begin
  Done         := False;        { **                              }
  Insert_Mode  := False;        {  * Initialize starting variables}
  GotoXY(Start_X,Y);            {  *                              }
  X := Start_X;                 { **                              }
  Write(Replicate(Buffer_Len,'_'));
  In_String := in_str;
  GotoXY(X,Y);
  Write (In_String);            {Write the initial value of the string}
  GotoXY(X,Y);

  Repeat                                 {Start main edit/input loop}

    If (X - Start_X) = Buffer_Len then
       Current_Char := ^M                {Terminate input if buffer is full}
    Else
       Read(Kbd,Current_Char);           {Get a character}

    If Force_Case then
      Current_Char := UpCase(Current_Char); {force case if necessary}

    Repeat
      Escape := False;
      Case Current_Char of        {Act on the current input}

        ^[        : If KeyPressed then
                      Begin
                      Read(Kbd,Current_Char);
                      Escape := True;
                      Case Current_Char of           {Translate escape codes to}
                        'H' : Current_Char := ^E;    {WordStar command codes   }
                        'P' : Current_Char := ^X;
                        'K' : Current_Char := ^S;
                        'M' : Current_Char := ^D;
                        'S' : Current_Char := ^G;
                        'R' : Current_Char := ^V;
                        '<' : Current_Char := ^R;
                        's' : Current_Char := ^A;
                        't' : Current_Char := ^F;
                        ';' : Begin
                              Help;
                              Current_Char := ^@;
                              End;
                        'D' : Begin                  {Special Terminator}
                              Done := True;
                              Escape := False;
                              End;
                        'I' : Begin
                              Done := True;
                              Escape := False;
                              End;
                        'Q' : Begin
                              Done := True;
                              Escape := False;
                              End;
                        'O' : Begin
                              Done := True;
                              Escape := False;
                              End;
                        'G' : Begin
                              Done := True;
                              Escape := False;
                              End;
                      End; {Case}
                      End; {^[}
        ^E        : Done := True;                  {**               }
                                                   { ** All finished }
        ^X        : Done := True;                  {**               }
        ^F        : x := start_x + length(in_string);
        ^A        : x := start_x;
        ^R        : Begin
                    In_string := in_str;
                    Gotoxy(start_x,y);
                    write(replicate(Buffer_len,'_'));
                    GotoXY(Start_X,Y);
                    Write(in_string);
                    End;

        ^V        : Insert_Mode := Insert_Mode XOR True; {toggle insert}

        ^S        : If X > Start_X then    {non destructive backspace}
                       X := X - 1;

        ^H,#127   : If X > Start_X then    {destructive backspace}
                       Begin
                       Delete(In_String, X - Start_X, 1);
                       GotoXY(Start_X,Y);
                       Write(In_String + '_');
                       X := X - 1;
                       End;

        ^D        : If (X - Start_X) < Buffer_Len then  {forward 1 character}
                      If (X - Start_X) < Length(In_String) Then
                        X := X + 1;

        ^G        : Begin
                    Delete(In_String, X - Start_X + 1,1); {delete character}
                    GotoXY(Start_X,Y);                    {under the cursor}
                    Write(In_String + '_');
                    End;

        ^M        : Done := True;         {**}
                                          { *** All Done}
        ^J        : Done := True;         {**}

        ' '..'~'  : If (X - Start_X) >= Length(In_String) Then
                      Begin
                      In_String := In_String + Current_Char;
                      GotoXY(X,Y);
                      Write(Current_Char);
                      If (X - Start_X) < Buffer_Len then
                        X := X + 1;
                      End

                    Else

                      If Insert_Mode then   {Just a run of the mill character}
                        Begin               {Insert Mode}
                        Insert(Current_Char,In_String, X - Start_X + 1);
                        In_String := Copy(In_String,1,Buffer_Len);
                        GotoXY(Start_X,Y);
                        Write(In_String);

                        If (X - Start_X) < Buffer_Len then
                          X := X + 1;
                        GotoXY(X,Y);
                        End

                      Else

                        Begin              {OverWrite Mode}
                        In_String[X - Start_X + 1] := Current_Char;
                        GotoXY(X,Y);
                        Write(Current_Char);
                        If (X - Start_X) < Buffer_Len then
                          X := X + 1;
                        End;

        Else
      End; {Case}
    Until Not Escape;
    GotoXY(X,Y);
    If KeyClick Then
      Click;
  Until Done;
  Get_Str := Current_Char;               {Return the terminator}
  In_str := In_string;
End;

{17**************************************************************************}
Function Get_Num  (                   {* This routine gets number from user *}
              var Value     : Real;   {* Current Value and Returned Value   *}
                  Decimals  : Integer;{* Number of Decimal Places           *}
                  Min_Value : Real;   {* Minimum Value                      *}
                  Max_Value : Real;   {* Maximum Value                      *}
                  X         : Byte;   {* Column                             *}
                  Y         : Byte    {* Row                                *}
                  )         : Char;   {* Terminator                         *}
                                      {*                                    *}
                                      {* This routine does basically the    *}
                                      {* thing as Get_Str only for numbers  *}
                                      {* There are more options however.    *}
                                      {* Basically Min and Max Value allow  *}
                                      {* to specify the range of acceptable *}
                                      {* values and DECIMALS allows you to  *}
                                      {* specify the number of decimal      *}
                                      {* places desired                     *}
                                      {**************************************}

Const
  Valid_Digits : Set of char = ['0'..'9','.','-','+','e'];

Var
  I1,I2  : Integer;
  S1     : Long_String;
  S2     : Long_String;
  S3     : Long_String;
  Inchar : Char;

Begin
  Str(Value:1:Decimals,S1);       {Convert to a string}
  Str(Max_Value:1:Decimals,S3);   {find out how long a string max val is}

  Repeat                 {Main Loop}
    S2 := '';

    Inchar := Get_Str(S1,Length(S3),X,Y,False); {Get_Str does the }
                                                           {work}
    For I2 := 1 to Length(S1) do     {Strip out non digits}
      If S1[I2] in Valid_Digits then
        S2 := S2 + S1[I2];

    Val(S2,Value,I1);                 {Find out its value}

  Until (Value >= Min_Value) and (Value <= Max_Value) and (I1 = 0); {do it }
                                                           {until its right}

  GotoXY(X,Y);

  Write_Neatly(Output,Value,Length(S3),Decimals); {print the result}

  Get_Num := Inchar;  {Assign the terminator}

end;

{18**************************************************************************}
procedure Frame(                      {* Frame the section of screen within *}
                UpperLeftX,           {* these bounds                       *}
                UpperLeftY,           {**************************************}
                LowerRightX,
                LowerRightY: Integer);
  var
    i: Integer;

begin
  GotoXY(UpperLeftX,UpperLeftY);
  Write(Chr(218));
  GotoXY(UpperLeftX,LowerRightY);
  Write(Chr(192));
  GotoXY(LowerRightX,UpperLeftY);
  Write(Chr(191));
  GotoXY(LowerRightX,LowerRightY);
  Write(Chr(217));
  For I := UpperLeftX + 1 to LowerRightX - 1 do
    Begin
    GotoXY(I,UpperLeftY);
    Write(Chr(196));
    GotoXY(I,LowerRightY);
    Write(Chr(196));
    End;
  For I := UpperLeftY + 1 to LowerRightY - 1 do
    Begin
    GotoXY(UpperLeftX,I);
    Write(Chr(179));
    GotoXY(LowerRightX,I);
    Write(Chr(179));
    End;
end;  { Frame }

{19***************************************************************************}
procedure UnFrame(                      {* This routine does the opposite of *}
                  UpperLeftX,           {* frame                             *}
                  UpperLeftY,           {*************************************}
                  LowerRightX,
                  LowerRightY: Integer);

var
  i: Integer;
begin
  GotoXY(UpperLeftX, UpperLeftY);
  Write(' ');

  for i:=UpperLeftX+1 to LowerRightX-1 do
    Write(' ');

  Write(' ');

  for i:=UpperLeftY+1 to LowerRightY-1 do
    begin
    GotoXY(UpperLeftX , i);
    Write(' ');
    GotoXY(LowerRightX, i);
    Write(' ');
    end;

    GotoXY(UpperLeftX, LowerRightY);
    Write(' ');

    for i:=UpperLeftX+1 to LowerRightX-1 do
      Write(' ');

    Write(' ');
end;  {UnFrame }

{****************************************************************************}
Function Menu (                               {* Display a Menu             *}
                Item_List  : Menu_Selections; {* List of Options on Menu    *}
                                              {* Last Item must be Null     *}
                                              {* String for proper operation*}
                                              {* No more than 14 items per  *}
                Menu_X     : Integer;         {* X Location of Menu         *}
                                              {* If Menu_X = 0 then the     *}
                                              {* Menu is centered on the    *}
                                              {* Screen                     *}
                Menu_Y     : Integer;         {* Y Location of Menu         *}
                Menu_Title : Menu_Item;       {* Title of Menu              *}
                Title_X    : Integer;         {* X Location of Title        *}
                                              {* If Title_X = 0 then the    *}
                                              {* Title is centered on the   *}
                                              {* screen                     *}
                Title_Y    : Integer;         {* Y Location of Title        *}
                Default    : Integer          {* Default Selection          *}
              )            : Integer;         {* Return the index of the    *}
                                              {* item selected by the user  *}
                                              {*                            *}
{***********************************************                            *
* This Routine Displays a Menu on the screen at the location specified by   *
* Menu_X and Menu_Y.  The Menu Title is displayed in Reverse Video at the   *
* Location specified by Title_X and Title_Y.  The User selects an item from *
* the menu by using <CTRL>-E to move a reverse video cursor bar up and      *
* <CTRL>-X to move it down.  After the cursor is on the item desired by the *
* user, he must press return.  At this point the routine returns the item   *
* number of the selection.                                                  *
*****************************************************************************}

Const
  CR = #13;
  Up = #5;
  Dn = #24;

Var
  Inchar : char;
  Menu_Pointer : 1..15;
  Menu_Length : 1..15;
  Last : Integer;
  Width : Integer;
  Len   : Integer;
  X1,X2,Y1,Y2 : Integer;
  I,j,k   : integer;
  instr : long_string;

Begin {Menu}

  instr := '';

  Width := Lower_Right_X - Upper_Left_X + 1;   {Calculate Window Size}
  Len   := Lower_Right_Y - Upper_Left_Y + 1;

  If Title_X <> 0 then       {position for the title}
    GotoXY(Title_X,Title_Y)
  Else
    GotoXY(1,Title_Y);

  RvsOn;

  If Title_X = 0 Then                 {Write the title}
    Write (Center(Width,Menu_Title))
  Else
    Write(Menu_Title);

  RvsOff;

  If Width > 38 then        {If there is enough room, write out instructions}
    Begin                   {otherwise, they is out a luck}
    Frame(1,Len-3,Width-1,Len);
    GotoXY((Width div 2) - 6,Len-3);
    Write(#17);
    RvsOn;
    Write('Instructions');
    RvsOff;
    Write(#16);
    TextColor(15);
    GotoXY(2,Len-2);
    Write(Center(Width-3,'Use '+#24+' and '+#25+' to Highlight a Selection'));
    GotoXY(2,Len-1);
    Write(Center(Width-3,' And '+#17+'DY to make the Selection'));
    TextColor(7);
    End;

  Inchar := ' ';               {Initialize variables}
  Menu_Pointer := 1;

  {Display the actual menu selections and determine how many selections
   are available}

  While (Menu_pointer <=15) and (length(Item_list[Menu_pointer]) > 0) do

    Begin
    If Menu_X <> 0 then
      Begin
      GotoXY(Menu_X,Menu_Y - 1 + Menu_Pointer);
      Write(Item_List[Menu_Pointer])
      End {If}
    Else
      Begin
      GotoXY(1,Menu_Y - 1 + Menu_Pointer);
      Write(Center(Width-1,Item_List[Menu_Pointer]))
      End; {Else}
    Menu_Pointer := Menu_Pointer + 1;
    End;  {While}

  Menu_Length := Menu_Pointer - 1;
  Menu_Pointer := Default;

  While inchar <> CR do          {Main loop}

    Begin
    If Menu_X <> 0 then
      Begin
      GotoXY(Menu_X,Menu_Pointer - 1 + Menu_Y); {Highlight the current menu}
      RvsOn;                                    {item}
      Write(Item_List[Menu_Pointer]);
      RvsOff;
      End {If}
    Else
      Begin
      GotoXY(1,Menu_Pointer - 1 + Menu_Y);
      RvsOn;
      Write(Center(Width-1,Item_List[Menu_Pointer]));
      RvsOff;
      End; {Else}

    Read(Kbd,Inchar);    {get a character from the user}
    Click;

    Last := Menu_Pointer;

    If Not (Inchar in [^[,Up,Dn,Cr]) then

      Begin

      if inchar = #127 then
        instr := ''
      else

        if inchar = ^H then
          delete(instr,length(instr),1)
        else
          instr := instr + inchar;

      j := 0;
      k := 0;

      for i := 1 to Menu_Length do

        if lower(instr) = lower(copy(item_list[i],1,length(instr))) then

          begin
          inc(j);

          if k = 0 then
            k := i;

          end;

      if k <> 0 then
        menu_pointer := k;

      if (j = 1) or (j = 0) then
        instr := '';

      end;

    If (Inchar = ^[) and KeyPressed then   {get the escape code}
      Read(Kbd, Inchar);

    If Inchar = ';' Then
      Begin
      X1 := Upper_Left_X;
      Y1 := Upper_Left_Y;
      X2 := Lower_Right_X;
      Y2 := Lower_Right_Y;
      Help;
      Window(X1,Y1,X2,Y2);
      End;

    If (Inchar = Up) Or (Inchar = 'H') then
      Begin                                    {They hit up arrow}
      Menu_Pointer := Menu_Pointer - 1;
      If Menu_Pointer < 1 then
        Menu_Pointer := Menu_Length;
      instr := '';
      End;  {If}

    If (Inchar = Dn) Or (Inchar = 'P') then
      Begin                                    {They hit down arrow}
      Menu_Pointer := Menu_Pointer + 1;
      if Menu_Pointer > Menu_Length then
        Menu_Pointer := 1;
      instr := '';
      end;  {If}

    If Menu_X <> 0 then                        {UnHighlight the old selection}
      Begin
      GotoXY(Menu_X, Last - 1 + Menu_Y);
      Write(Item_List[Last]);
      End {If}
    Else
      Begin
      GotoXY(1, Last - 1 + Menu_Y);
      Write(Center(Width-1,Item_List[Last]));
      End; {Else}

    End; {While}

  Beep(440);                                {They made a selection, beep once}
  Menu := Menu_Pointer;                     {to confirm}

end; {Menu}

{22**************************************************************************}
Procedure Window_Frame(x1,y1,             {* Create, frame and title a      *}
                       x2,y2 : Integer;   {* window                         *}
                       Title : Menu_Item);{**********************************}

Var
  Center : Integer;

Begin
  Window(1,1,80,25);
  Frame(x1 - 1, y1 - 1,
        x2 + 1, y2 + 1);
  Center := ((x2 - x1) div 2) + x1;
  GotoXY(Center - (Length(Title) div 2)-1,y1-1);
  Write(#17);
  RvsOn;
  Write(Title);
  RvsOff;
  Write(#16);
  Window(x1,y1,x2,y2);
  Clear_Window;
End;

{23**************************************************************************}
Function Encrypt(Password : Long_String) {* Encrypt a string using the      *}
                : Long_String;           {* following algorithm:            *}
                                         {*  XOR the ordinal value of each  *}
  Var                                    {* character in the string with    *}
    Temp : Long_String;                  {* that of the next character in   *}
    I : Integer;                         {* the string.  Multiply by 2 the  *}
                                         {* result and convert back to char *}
  Begin                                  {* leave the last character of the *}
    temp := '';                          {* string in plain text as the key *}
    For I := 1 to Length(Password) - 1 do{***********************************}
      temp := Temp + Chr((ord(password[i]) xor ord(password[i+1])) shl 2);
    Encrypt := Temp + Password[Length(Password)];
  End;

{24**************************************************************************}
Function Decrypt(Temp : Long_String)     {* Decrypt a string encrypted by   *}
                : Long_String;           {* the preceding procedure         *}
                                         {***********************************}
  Var
    Password : Long_String;
    I : Integer;

  Begin
    Password := Replicate(Length(temp),' ');
    Password[Length(temp)] := Temp[Length(temp)];
    For I := Length(Temp) - 1 downto 1 do
      Password[I] := Chr((ord(temp[i]) shr 2) xor ord(password[i+1]));
    Decrypt := Password;
  End;

{25**************************************************************************}
Function GetChar(Var Done : Boolean) : Char;{* Get a character from the Kbd *}
                                            {********************************}
Var
  Inchar : Char;

Begin
  Read(Kbd,Inchar);
  Done := (Inchar = ^\);
  GetChar := Inchar;
End;

{27**************************************************************************}
Function Get_Pass(X,Y : Integer) : Long_String;{* This routine obtains a    *}
                                               {* password from the user    *}
Var                                            {* nothing more, nothing less*}
  Inchar : Char;                               {*****************************}
  Temp   : Long_String;

Begin
  GotoXY(X,Y);
  Write('Password: ');
  Temp := '';
  TextColor(0);
  TextBackGround(0);
  Inchar := Get_Str(Temp,10,X + 10,y,True);
  RvsOff;
  If Temp = Replicate(10,' ') then
    Temp := '';
  Get_Pass := Temp;
End;

{32**************************************************************************}
Procedure SetUp  {Set the UART for communications}
               (Portal : Integer;
                Baud   : Integer;
                Parity : Parity_Types;
                Stop   : Byte;
                Word   : Byte);

Begin

  Port[LCR + Portal] := 128;

  {Set Baud Rate}
  Baud := Trunc(115200.0 / Baud);
  Port[DLL + Portal] := Lo(Baud);
  Port[DLM + Portal] := Hi(Baud);

  {Set Parity}
  Case Parity of
    No_Parity   : Port[LCR + Portal] := Port[LCR + Portal] And Not(PEN);
    Even_Parity : Begin
                  Port[LCR + Portal] := Port[LCR + Portal] Or PEN;
                  Port[LCR + Portal] := Port[LCR + Portal] Or EPS;
                  Port[LCR + Portal] := Port[LCR + Portal] And Not(STPTY);
                  End;
    Odd_Parity  : Begin
                  Port[LCR + Portal] := Port[LCR + Portal] Or PEN;
                  Port[LCR + Portal] := Port[LCR + Portal] And Not(EPS);
                  Port[LCR + Portal] := Port[LCR + Portal] And Not(STPTY);
                  End;
  End;

  {Set Stop Bits}
  Port[LCR + Portal] := Port[LCR + Portal] And (Not(STB) + (STB * (Stop - 1)));

  {Set Word Length}
  Port[LCR + Portal] := Port[LCR + Portal] And Not(WLS);
  Word := (Word - 5) and WLS;
  Port[LCR + Portal] := Port[LCR + Portal] or Word;

  Port[LCR + Portal] := Port[LCR + Portal] And 127;

End; {Set up}

{36**************************************************************************}
Procedure DosConOut(Ch : Char);      {* Write character to video display    *}
                                     {* using DOS driver                    *}
Var                                  {***************************************}
  Registers : Reg;

Begin
  Registers.AX := $0200;
  Registers.DX := Ord(Ch);
  MsDos(Registers);
End;

var
  serial_buffer : long_string;

{37**************************************************************************}
Procedure SerialOut(Ch : Char);      {* This routine sends a character over *}
                                     {* the rs232 using a standard BIOS call*}
Var                                  {* (INT 14)                            *}
  Registers : Reg;                   {***************************************}

Begin
  Registers.AX := $0100 + Ord(Ch);    {Set the registers}
  Registers.DX := Com;
  Intr($14,Registers);               {Send out the character}
End;

{40**************************************************************************}
Function Data : Boolean;             {* This routine returns true if the    *}
                                     {* serial port has valid data          *}
Var                                  {***************************************}
  Registers : Reg;
  portno    : integer;

Begin
  portno := $3fd - ($100 * Com);
  data := (port[portno] and 1) = 1;
End;

{38**************************************************************************}
Function SerialIn : Char;            {* This routine reads a character from *}
                                     {* the serial port if one is available *}
Var                                  {* If no character is available, the   *}
  Registers : Reg;                   {* returns a null char (^@).           *}
  ch        : char;                  {***************************************}

Begin
  serialin := chr(port[$3f8 - ($100 * com)]);
End;

{41**************************************************************************}
Procedure ColScr;                    {* Switch to Color Monitor if it is    *}
                                     {* available, otherwise leave as is    *}
Const                                {***************************************}
  VidReg : Array[0..15] of Integer =
  ($71,$50,$5A,$0A,$1F,$06,$19,$1C,$02,$07,$06,$07,$00,$00,$00,$00);
  Mode     = $3B8;
  Color    = $3B9;
  RegNum   = $3D4;
  RegVal   = $3D5;
  ColorVal = $30;
  ModeVal  = $2D;

Var
  I : Byte;

Begin
{  Port[Mode] := ModeVal;
  Port[Color] := ColorVal;
  For I := 0 to 15 do
    Begin
    Port[RegNum] := I;
    Port[RegVal] := VidReg[I];
    End;
}  Screen := Ptr($B800,0);
End;

{42**************************************************************************}
Procedure MonoScr;                   {* Switch to MonoChrome Monitor if     *}
                                     {* available, otherwise leave as is    *}
Const                                {***************************************}
  VidReg : Array[0..15] of Integer =
  ($61,$50,$52,$0F,$19,$06,$19,$19,$02,$0D,$0B,$0C,$00,$00,$00,$00);

  Mode     = $3B8;
  Color    = $3B9;
  RegNum   = $3B4;
  RegVal   = $3B5;
  ColorVal = $30;
  ModeVal  = $29;

Var
  I : Byte;

Begin
  Port[Mode] := ModeVal;
  Port[Color] := ColorVal;
  For I := 0 to 15 do
    Begin
    Port[RegNum] := I;
    Port[RegVal] := VidReg[I];
    End;
  Screen := Ptr($B000,0);
End;

{45**************************************************************************}
Procedure Well;

Var
  I,J : Integer;

Begin
  I := 0;
  While Not KeyPressed do
    Begin
    Click;
    Delay(250);
    If I = 100 then Write('Well?');
    Inc(I);
    End;
End;

{47**************************************************************************}
Procedure Siren;                     {* This is the alarm for intruder alert*}
                                     {***************************************}
var i,j : integer;

begin
  for j := 1 to 20 do
    begin
    for i := 200 to 2300 do
      sound(i);
    nosound;
    delay(100);
    end;
end;

{48**************************************************************************}
type
  typelist = (ustr,lstr,ulstr,rnum,inum,yn);

function getform(   var value;
                        vtype   : typelist;
                        X,Y,
                        dp,Len  : integer;
                        Lstrg   : long_string;
                        lx,ly   : integer
                              ) : char;

var
  realval : real absolute value;
  intval  : integer absolute value;
  strval  : long_string absolute value;
  boolval : boolean absolute value;
  mval    : real;
  tint    : integer;
  tstr    : long_string;
  tchar   : char;

begin
  gotoxy(lx,ly);
  highvideo;
  write(lstrg);
  case vtype of

    ustr  : getform := get_str(strval,len,x,y,true);
    lstr  : begin
            getform := get_str(strval,len,x,y,false);
            strval := lower(strval);
            end;
    ulstr : getform := get_str(strval,len,x,y,false);
    rnum  : begin
            val(replicate(len - dp - 1,'9'),mval,tint);
            getform := get_num(realval,dp,0,mval,x,y);
            end;
    inum  : begin
            getform := get_num(mval,0,-32767,maxint,x,y);
            intval := trunc(mval);
            end;
    yn    : begin
            gotoxy(x,y);
            if boolval then
              tstr := 'Y'
            else
              tstr := 'N';
            repeat
              tchar := get_str(tstr,1,x,y,true);
            until tstr[1] in ['Y','N'];
            boolval := tstr = 'Y';
            getform := tchar;
            end;
  end;

  gotoxy(lx,ly);
  lowvideo;
  write(lstrg);
end;

{*********************************************************************}

const monthmask = $000F;
      daymask = $001F;
      minutemask = $003F;
      secondmask = $001F;
type  dtstr = string[8];

{49*******************************************************************}

function getdate : dtstr;

var
  allregs : register;
  month, day,
  year    : string[2];
  i       : integer;
  tstr    : dtstr;

begin
   allregs.ax := $2A * 256;
   MsDos(allregs);
   str((allregs.dx div 256):2,month);
   str((allregs.dx mod 256):2,day);
   str((allregs.cx - 1900):2,year);
   tstr := month + '/' + day + '/' + year;
   for i := 1 to 8 do
     if tstr[i] = ' ' then
       tstr[i] := '0';
   getdate := tstr;
end;  {getdate}

{50*******************************************************************}

function gettime : dtstr;

var
 allregs : register;
 hour, minute,
 second  : string[2];
 i       : integer;
 tstr    : dtstr;

begin
   allregs.ax := $2C * 256;
   MsDos(allregs);
   str((allregs.cx div 256):2,hour);
   str((allregs.cx mod 256):2,minute);
   str((allregs.dx div 256):2,second);
   tstr := hour + ':' + minute + ':' + second;
   for i := 1 to 8 do
     if tstr[i] = ' ' then
       tstr[i] := '0';
   gettime := tstr;
end;  {gettime}

{51*******************************************************************}
procedure push_window(x1,y1,x2,y2 : integer);

var
  temp : video_ptr;
  i,j,k  : integer;

begin
  if screen = nil then
    screen := ptr($b000,0);
  new(Temp);
  temp^.x1 := x1;
  temp^.y1 := y1;
  temp^.x2 := x2;
  temp^.y2 := y2;
  getmem(temp^.screen_store,((x2 - x1 + 1) * (y2 - y1 + 1)) * 2);
  Temp^.Next_Screen := Screen_Stack;
  k := 1;
  for i := y1 to y2 do
    for j := x1 to x2 do
      begin
      temp^.screen_store^[k] := screen^[i][j];
      inc(k);
      end;
  Screen_Stack := Temp;
end;

{52*******************************}
function elapsed_time(start_time : real) : real;

var
  j       : integer;
  i,k,
  endtime : real;

begin
  val(copy(gettime,7,2),i,j);
  endtime := i * 3600.0;
  val(copy(gettime,5,2),i,j);
  endtime := endtime + (i * 60);
  val(copy(gettime,1,2),i,j);
  endtime := endtime + i;
  k := endtime - start_time;
  elapsed_time := k
end;